home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / dll_gen / winfox / modules.wd_ / modules.wd (.txt)
Encoding:
Visual Basic Form  |  1995-01-31  |  9.0 KB  |  275 lines
  1. VERSION 2.00
  2. Begin Form Modules 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Modules Active On System"
  6.    ClientHeight    =   5790
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1500
  9.    ClientWidth     =   7365
  10.    ControlBox      =   0   'False
  11.    Height          =   6195
  12.    Left            =   1035
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   5790
  17.    ScaleWidth      =   7365
  18.    Top             =   1155
  19.    Width           =   7485
  20.    Begin ListBox ListTask 
  21.       Height          =   225
  22.       Left            =   480
  23.       TabIndex        =   10
  24.       Top             =   5520
  25.       Visible         =   0   'False
  26.       Width           =   2775
  27.    End
  28.    Begin ListBox ListHidden 
  29.       Height          =   225
  30.       Left            =   3660
  31.       Sorted          =   -1  'True
  32.       TabIndex        =   6
  33.       Top             =   5520
  34.       Visible         =   0   'False
  35.       Width           =   3375
  36.    End
  37.    Begin CommandButton CmdOkay 
  38.       BackColor       =   &H00C0C0C0&
  39.       Cancel          =   -1  'True
  40.       Caption         =   "O &K A Y"
  41.       Default         =   -1  'True
  42.       Height          =   375
  43.       Left            =   3840
  44.       TabIndex        =   4
  45.       TabStop         =   0   'False
  46.       Top             =   5100
  47.       Width           =   3135
  48.    End
  49.    Begin CommandButton CmdDetails 
  50.       BackColor       =   &H00C0C0C0&
  51.       Caption         =   "Show &Details"
  52.       Height          =   375
  53.       Left            =   3840
  54.       TabIndex        =   3
  55.       TabStop         =   0   'False
  56.       Top             =   4680
  57.       Width           =   3135
  58.    End
  59.    Begin CommandButton CmdRefresh 
  60.       BackColor       =   &H00C0C0C0&
  61.       Caption         =   "&Refresh List"
  62.       Height          =   375
  63.       Left            =   420
  64.       TabIndex        =   2
  65.       TabStop         =   0   'False
  66.       Top             =   5100
  67.       Width           =   3135
  68.    End
  69.    Begin CommandButton CmdUnload 
  70.       BackColor       =   &H00C0C0C0&
  71.       Caption         =   "&Unload Module"
  72.       Height          =   375
  73.       Left            =   420
  74.       TabIndex        =   1
  75.       TabStop         =   0   'False
  76.       Top             =   4680
  77.       Width           =   3135
  78.    End
  79.    Begin ListBox List1 
  80.       FontBold        =   0   'False
  81.       FontItalic      =   0   'False
  82.       FontName        =   "Terminal"
  83.       FontSize        =   9
  84.       FontStrikethru  =   0   'False
  85.       FontUnderline   =   0   'False
  86.       Height          =   2550
  87.       Left            =   360
  88.       Sorted          =   -1  'True
  89.       TabIndex        =   0
  90.       Top             =   1560
  91.       Width           =   6675
  92.    End
  93.    Begin Label Label4 
  94.       Alignment       =   2  'Center
  95.       BackStyle       =   0  'Transparent
  96.       Caption         =   "Label4"
  97.       ForeColor       =   &H00000000&
  98.       Height          =   315
  99.       Left            =   360
  100.       TabIndex        =   9
  101.       Top             =   4200
  102.       Width           =   6675
  103.    End
  104.    Begin Label Label3 
  105.       BackStyle       =   0  'Transparent
  106.       Caption         =   "Label1"
  107.       FontBold        =   0   'False
  108.       FontItalic      =   0   'False
  109.       FontName        =   "Terminal"
  110.       FontSize        =   9
  111.       FontStrikethru  =   0   'False
  112.       FontUnderline   =   0   'False
  113.       ForeColor       =   &H00000000&
  114.       Height          =   255
  115.       Left            =   360
  116.       TabIndex        =   8
  117.       Top             =   1320
  118.       Width           =   6675
  119.    End
  120.    Begin Label Label2 
  121.       Alignment       =   2  'Center
  122.       BackStyle       =   0  'Transparent
  123.       Caption         =   "Label1"
  124.       ForeColor       =   &H00000080&
  125.       Height          =   435
  126.       Left            =   360
  127.       TabIndex        =   7
  128.       Top             =   660
  129.       Width           =   6675
  130.    End
  131.    Begin Label Label1 
  132.       Alignment       =   2  'Center
  133.       BackStyle       =   0  'Transparent
  134.       Caption         =   "Label1"
  135.       ForeColor       =   &H00800000&
  136.       Height          =   435
  137.       Left            =   360
  138.       TabIndex        =   5
  139.       Top             =   180
  140.       Width           =   6675
  141.    End
  142. Declare Sub FreeLibrary Lib "Kernel" (ByVal hModule%)
  143. Sub CmdDetails_Click ()
  144.     If List1.ListIndex = -1 Or List1.ListCount = 0 Then
  145.         MsgBox "No item selected!", 64, "Module Details"
  146.         Exit Sub
  147.         End If
  148.     x = List1.ListIndex
  149.     sModule$ = ExtractField(x, 1)
  150.     hModule$ = Trim$(ExtractField(x, 2))
  151.     iUsage$ = Trim$(ExtractField(x, 3))
  152.     iSize$ = Format$(Val(ExtractField(x, 4)), "###,###,##0")
  153.     sFullPath$ = LCase$(ExtractField(x, 5))
  154.         
  155.     msg$ = "Module Name:" + Chr$(9) + sModule$ + nl
  156.     msg$ = msg$ + "Handle:" + Chr$(9) + Chr$(9) + hModule$ + nl
  157.     msg$ = msg$ + "Usage Count:" + Chr$(9) + iUsage$ + nl
  158.     msg$ = msg$ + "Size (bytes):" + Chr$(9) + iSize$ + nl
  159.     msg$ = msg$ + "Full Path:" + Chr$(9) + sFullPath$
  160.     MsgBox msg$, 48, "Selected Module Details"
  161.     List1.SetFocus
  162. End Sub
  163. Sub CmdOkay_Click ()
  164.     Unload Me
  165. End Sub
  166. Sub CmdRefresh_Click ()
  167.     List1.Visible = False
  168.     Screen.MousePointer = 11
  169.     RefreshView
  170.     List1.Visible = True
  171.     Screen.MousePointer = 0
  172.     List1.SetFocus
  173. End Sub
  174. Sub CmdUnload_Click ()
  175.     x = List1.ListIndex
  176.     iUsage% = Val(ExtractField(x, 3))
  177.     hModule% = Val(ExtractField(x, 2))
  178.     ReturnString$ = Space$(255)
  179.     GetToken List1.List(x), Chr$(9), 5, ReturnString$
  180.     sAppType$ = Right$(TrimAtNull(ReturnString$), 3)
  181.     'If sAppType$ <> "exe" Then
  182.         FreeLibrary hModule%
  183.     '    Else
  184.     '    MsgBox "Can NOT unload an EXE module.", 48, "Unload Module"
  185.     '    End If
  186.     If iUsage% = 1 Then
  187.         CmdRefresh_Click
  188.         Else
  189.         sModule$ = ExtractField(x, 1)
  190.         nhModule$ = JustifyRight(Format$(hModule%), " ", 6)
  191.         niUsage$ = JustifyRight(Format$(iUsage% - 1), " ", 6)
  192.         sApp$ = ExtractField(x, 5)
  193.         ReturnString$ = Space$(255)
  194.         FromPath sApp$, "FullFileName", ReturnString$
  195.         sApp$ = LCase$(TrimAtNull(ReturnString$))
  196.         List1.RemoveItem x
  197.         List1.AddItem sModule$ + Chr$(9) + nhModule$ + Chr$(9) + niUsage$ + Chr$(9) + sApp$
  198.         List1.ListIndex = x
  199.         LBfillModuleInfo ListHidden.hWnd, False
  200.         End If
  201. AllDone:
  202.     List1.SetFocus
  203.     Exit Sub
  204. End Sub
  205. Function ExtractField$ (RecordItem, FieldItem)
  206.     'When using a hidden module like this, it is best to
  207.     'set the Sort property of both ListBoxes to the same value
  208.     If RecordItem > ListHidden.ListCount Then
  209.         ExtractField = ""
  210.         Exit Function
  211.         End If
  212.     ThisRecord$ = ListHidden.List(RecordItem)
  213.     delimiter$ = Chr$(9)
  214.     If GetTokenCount(ThisRecord$, delimter$) > FieldItem Then
  215.         ExtractField = ""
  216.         Exit Function
  217.         End If
  218.     ReturnString$ = Space$(255)
  219.     GetToken ThisRecord$, delimiter$, FieldItem, ReturnString$
  220.     ExtractField = TrimAtNull(ReturnString$)
  221. End Function
  222. Sub Form_Load ()
  223.     FormCenterScreen Me
  224.     msg$ = "This example uses the LBfillModuleInfo routine." + nl
  225.     msg$ = msg$ + "Using a hidden ListBox, it selects specific data."
  226.     Label1.Caption = msg$
  227.     msg$ = "Unload modules at your own risk!!!" + nl
  228.     msg$ = msg$ + "Unloading an active module can cause a GPF!!!"
  229.     Label2.Caption = msg$
  230.     Label3.Caption = "Module Name" + Space$(9) + "Handle" + Space$(5) + "Usage" + Space$(4) + "File Name"
  231.     ReDim tabsets%(4)
  232.     tabsets%(0) = 0
  233.     tabsets%(1) = 20 * 4
  234.     tabsets%(2) = 30 * 4
  235.     tabsets%(3) = 40 * 4
  236.     tabsets%(4) = 50 * 4
  237.     dummy% = OutMessage(List1.hWnd, 1043, 5, tabsets%(0))
  238.     RefreshView
  239.     Screen.MousePointer = 0
  240. End Sub
  241. Sub Form_Paint ()
  242.     DoForm3D Me, "raised", 2, 0
  243.     DoForm3D Me, "sunken", 2, 2
  244.     DoControl3D List1, "sunken", 2
  245. End Sub
  246. Sub List1_DblClick ()
  247.     CmdDetails_Click
  248. End Sub
  249. Sub RefreshView ()
  250.     LBfillModuleInfo ListHidden.hWnd, False
  251.     If ListHidden.ListCount = 0 Then
  252.         Label4.Caption = ""
  253.         Exit Sub
  254.         End If
  255.     List1.Clear
  256.     For x = 0 To ListHidden.ListCount - 1
  257.         sModule$ = ExtractField(x, 1)
  258.         hModule$ = ExtractField(x, 2)
  259.         iUsage$ = ExtractField(x, 3)
  260.         sApp$ = ExtractField(x, 5)
  261.         ReturnString$ = Space$(255)
  262.         FromPath sApp$, "FullFileName", ReturnString$
  263.         sApp$ = LCase$(TrimAtNull(ReturnString$))
  264.         List1.AddItem sModule$ + Chr$(9) + hModule$ + Chr$(9) + iUsage$ + Chr$(9) + sApp$ + Chr$(9)
  265.         Next x
  266.     ItemCount% = ListHidden.ListCount
  267.     If ItemCount% > 1 Then
  268.         word$ = " modules "
  269.         Else
  270.         word$ = " module "
  271.         End If
  272.     Label4.Caption = Format$(ItemCount%, "###,##0") + " active" + word$ + "detected"
  273.     List1.ListIndex = 0
  274. End Sub
  275.